home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d11 / display.arc / ART.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-30  |  4.0 KB  |  215 lines
  1. Program ArtExample;
  2. {
  3.           ART DEMONSTRATION PROGRAM  Version 1.00A
  4.  
  5.      This program demonstrates the use of color graphics
  6.      using TURBO PASCAL on the IBM PC and true compatibles
  7.      with a color graphics adapter.
  8.  
  9.      INSTRUCTIONS
  10.      1.  Compile and run this program using the TURBO.COM
  11.          compiler.
  12.      2.  Type <ESC> to exit the program, any other key to
  13.          regenerate the screen.
  14.  
  15.  
  16.      MODIFIED by Kent Cedola to use EGA Graphic Primitives.
  17.  
  18. }
  19.  
  20. const
  21.   MemorySize = 200;
  22.  
  23. var
  24.   X1, X2, Y1, Y2,
  25.   CurrentLine,
  26.   ColorCount,
  27.   IncrementCount,
  28.   DeltaX1, DeltaY1, DeltaX2, DeltaY2,
  29.   I, Color: integer;
  30.   Ch: char;
  31.   Line: array [1..MemorySize] of record
  32.                                    LX1, LY1: integer;
  33.                                    LX2, LY2: integer;
  34.                                    LColor:  integer;
  35.                                  end;
  36.  
  37. {$I GPPARMS.P }
  38. {$I GPINIT.P  }
  39. {$I GPTERM.P  }
  40. {$I GPCOLOR.P }
  41. {$I GPMOVE.P  }
  42. {$I GPLINE.P  }
  43. {$I GPVIEWPO.P }
  44.  
  45. procedure Check;
  46. var
  47.   ch: char;
  48. begin
  49.  
  50.   GPPARMS;
  51.  
  52.   if GDTYPE <> 5 then
  53.     begin
  54.     ClrScr;
  55.     Writeln('Enhanced Graphic Adapter and Display not found!');
  56.     Halt(1);
  57.     end;
  58.  
  59.   if GDMEMORY = 64 then
  60.     begin
  61.     ClrScr;
  62.     Writeln('This program works much better with 128k or more EGA memory!');
  63.     Writeln;
  64.     Writeln('   Hit any key to continue...');
  65.     Read(KBd,Ch);
  66.     end;
  67.  
  68. end;
  69.  
  70. procedure Init;
  71. begin
  72.  
  73.   GPINIT;
  74.   GPVIEWPORT(50,50,300,300);
  75.   for I := 1 to MemorySize do
  76.   with Line[I] do
  77.   begin
  78.     LX1 := 0;
  79.     LX2 := 0;
  80.     LY1 := 0;
  81.     LY2 := 0;
  82.   end;
  83.   X1 := 0;
  84.   Y1 := 0;
  85.   X2 := 0;
  86.   Y2 := 0;
  87.   CurrentLine := 1;
  88.   ColorCount := 0;
  89.   IncrementCount := 0;
  90.   Ch := ' ';
  91.   GPCOLOR(2);
  92.   Color := 2;
  93.   gotoxy(1,25);
  94.   write('Press any key to regenerate, ESC to stop');
  95. end;
  96.  
  97. procedure AdjustX(var X,DeltaX: integer);
  98. var
  99.   TestX: integer;
  100. begin
  101.   TestX := X+DeltaX;
  102.   if (TestX<1) or (TestX>GDMAXCOL - 1) then
  103.   begin
  104.     TestX := X;
  105.     DeltaX := -DeltaX;
  106.   end;
  107.   X := TestX;
  108. end;
  109.  
  110. procedure AdjustY(var Y,DeltaY: integer);
  111. var
  112.   TestY: integer;
  113. begin
  114.   TestY := Y+DeltaY;
  115.   if (TestY<1) or (TestY> GDMAXROW - 32) then
  116.   begin
  117.     TestY := Y;
  118.     DeltaY := -DeltaY;
  119.   end;
  120.   Y := TestY;
  121. end;
  122.  
  123. procedure SelectNewColor;
  124. begin
  125.   Color := Random(GDMAXPAL-1)+1;
  126.   ColorCount := 5*(1+Random(10));
  127. end;
  128.  
  129. procedure SelectNewDeltaValues;
  130. begin
  131.   DeltaX1 := Random(7)-3;
  132.   DeltaX2 := Random(7)-3;
  133.   DeltaY1 := Random(7)-3;
  134.   DeltaY2 := Random(7)-3;
  135.   IncrementCount := 4*(1+Random(9));
  136. end;
  137.  
  138. procedure SaveCurrentLine;
  139. begin
  140.   with Line[CurrentLine] do
  141.   begin
  142.     LX1 := X1;
  143.     LY1 := Y1;
  144.     LX2 := X2;
  145.     LY2 := Y2;
  146.     LColor := Color;
  147.   end;
  148. end;
  149.  
  150. procedure Regenerate;
  151. var
  152.   I: integer;
  153. begin
  154.   NoSound;
  155.   GPINIT;
  156.   for I := 1 to MemorySize do
  157.     with Line[I] do
  158.       begin
  159.       GPCOLOR(LColor);
  160.       GPMOVE(LX1,LY1);
  161.       GPLINE(LX2,LY2);
  162.       end;
  163.   gotoxy(1,25);
  164.   write('Press any key to continue, ESC to stop');
  165.   read(Kbd,Ch);
  166. end;
  167.  
  168. procedure WanderingLines;
  169. begin
  170.   repeat
  171.     repeat
  172.       with Line[CurrentLine] do
  173.         begin
  174.         GPCOLOR(Black);
  175.         GPMOVE(LX1,LY1);
  176.         GPLINE(LX2,LY2);
  177.         end;
  178.  
  179.       if ColorCount=0 then SelectNewColor;
  180.       if IncrementCount=0 then SelectNewDeltaValues;
  181.  
  182.       AdjustX(X1,DeltaX1);
  183.       AdjustY(Y1,DeltaY1);
  184.       AdjustX(X2,DeltaX2);
  185.       AdjustY(Y2,DeltaY2);
  186.  
  187.       GPCOLOR(Color);
  188.       GPMOVE(X1,Y1);
  189.       GPLINE(X2,Y2);
  190.  
  191.       SaveCurrentLine;
  192.  
  193.       CurrentLine := Succ(CurrentLine);
  194.       if CurrentLine>MemorySize then CurrentLine := 1;
  195.       ColorCount := Pred(ColorCount);
  196.       IncrementCount := Pred(IncrementCount);
  197.     until KeyPressed;
  198.     read(Kbd,Ch);
  199.     if Ch <> #27 then
  200.     begin
  201.       Regenerate;
  202.       gotoxy(1,25);
  203.       write('Press any key to regenerate, ESC to stop');
  204.     end;
  205.   until Ch = #27;
  206. end;
  207.  
  208. begin
  209.   ClrScr;
  210.   Check;
  211.   Init;
  212.   WanderingLines;
  213.   TextMode;
  214. end.
  215.